#!
# by jzhang @ 13:37 2006-10-03  mailto:jzhang533@gmail.com
#
package jzhang::WWWUtil;

our @ISA = qw(Exporter);
our @EXPORT_OK = qw( retry_get retry_head grab_urls grab_link_with_imgs);
our @EXPORT = qw();
our %EXPORT_TAGS = (
    'all' => [ @EXPORT_OK,@EXPORT ]
    );

use warnings;
use strict;
use LWP;
use URI::URL;
use HTML::TreeBuilder;

sub retry_get {
    my ($agent,$link)=@_;
    my $max_retry = 1;
    my $count=0;
    my $res = $agent->get($link);
    while($count<$max_retry and ( (not defined $res ) or $res->code != 200) ) {
        $res = $agent->get($link);
        $count ++;
    }
#    $res=undef if($res->code != 200);
    return $res;
}

sub retry_head {
    my ($agent,$link)=@_;
    my $max_retry = 1;
    my $count=0;
    my $res = $agent->head($link);
    while($count<$max_retry and ( (not defined $res ) or $res->code != 200) ) {
        $res = $agent->head($link);
        $count ++;
    }
#    $res=undef if($res->code != 200);
    return $res;
}


sub canonicalization {
    my $base    = shift;
    my $org_url = shift;

    my $full_child =  eval {
        (new URI::URL $org_url, $base)->abs($base,1);
    };
    return "" if ($@);   
    my $ret_url=$full_child->as_string();
    $ret_url=~s/\#.*$//g;
    $ret_url=~s!&amp;!&!ig;
    return $ret_url; 
}

sub grab_urls {
    my $base = shift;
    my ($data) =  @_;
    my %urls;
    my $link;
    my $anchor;
    $data=~ s/[\n\r]//g;
    # while there are HTML tags
    while ($data =~ s/<a\s+([^>]+)>//is) {
        my $in_brackets=$1;
#print "\n----------\n$in_brackets\n----------------\n";
        if ($in_brackets =~ /href\s*=\s*["']+([^"']*)["']/is) {
            $link=$1;
        }elsif ($in_brackets =~ /href\s*=\s*([^\s]+)/is) { # handle case when url isn't in quotes (ie: <a href=thing>)
            $link=$1;
        }else {
            next;
        }
        $link = canonicalization $base,$link;
        
        next if $link eq "";
        next if $link =~ /javascript/i;
        next if $link =~ /mailto/i;
        
        $urls{$link} = 1;
    }  # while there are brackets
    keys %urls;
}

# given base and HTML,
# find all images with links by HTML::Parser
# return a hash;
sub grab_link_with_imgs{
    my $base=shift;
    my ($HTML) = @_;

    my %link_imgs;

    my $tree= HTML::TreeBuilder->new();
    $tree->parse($HTML);

    my @links = $tree->find_by_tag_name('a');

    for my $l (@links){
        my ($i)=$l->find_by_tag_name('img');
        next unless $i;
	my $u = $l->attr('href');
	my $s = $i->attr('src');
        
#next unless $s =~ /\.jpg/i;

	next if $u eq "" or $s eq "";
        next if $u =~ /javascript/i;
        next if $u =~ /mailto/i;
	
	$u=canonicalization($base,$u);
	$s=canonicalization($base,$s);

	$link_imgs{$u}=$s;
    }
     
# remember to delete the tree explicitly 
    $tree->delete();
    return %link_imgs;
}
1;

